@@ -2,16 +2,22 @@ use strict;
use warnings;
use Module::Build;
+# If you updated this, don't forget to update the Makefile.PL file as well!
+
my $builder = Module::Build->new(
module_name => 'Getopt::Euclid',
- license => 'perl',
dist_author => 'Damian Conway <DCONWAY@cpan.org>',
+ license => 'perl',
dist_version_from => 'lib/Getopt/Euclid.pm',
+
requires => {
- 'Test::More' => 0,
- 'version' => 0,
+ 'Test::More' => 0,
+ 'version' => 0,
+ 'File::Basename' => 0,
'File::Spec::Functions' => 0,
- 'List::Util' => 0,
+ 'List::Util' => 0,
+ 'Text::Balanced' => 0,
+ 'Perl::Tidy' => 0,
},
add_to_cleanup => [ 'Getopt-Euclid-*' ],
);
@@ -1,5 +1,22 @@
Revision history for Getopt-Euclid
+0.2.7
+ - Updated dependencies in Build.PL module
+
+0.2.6
+ - Bugfix: corrected a .pod file finding issue
+
+0.2.5
+ - Bugfix for #69324: more efficient and accurate POD extraction using Perl::Tidy
+ - Bugfix for #29301: automatically looking for POD located into .pod files
+ - Bugfix for #69105: file META.yml states which license the module uses
+ - Bugfix for #34200: variables in constraint specifications are read as
+ originating from the 'main' package namespace
+ - Little internal modification to prevent identical placeholders that are
+ present multiple times in the specification to be processed multiple times.
+ - Error messages for arguments that do not validate against the constraints
+ now display the value of variables instead of their name.
+
0.2.4
- Default values can now be specified in the POD and displayed in the program
documentation
@@ -1,8 +1,9 @@
Build.PL
Changes
-doc-pak/README
lib/Getopt/Euclid.pm
lib/Getopt/Euclid/HierDemo.pm
+lib/Getopt/Euclid/HierDemo.pod
+lib/Getopt/Euclid/PodExtract.pm
Makefile.PL
MANIFEST This list of files
README
@@ -47,12 +48,15 @@ t/minimal.t
t/pod.t
t/pod_cmd_after_cut.t
t/pod_coverage.t
+t/pod_file.pod
+t/pod_file.t
t/quoted_args.t
-t/regex_type.t
t/repeatable.t
t/repeated.t
t/simple.t
t/simple_shuffle.t
t/types.t
+t/types_regex.t
+t/types_vars.t
t/vars_export.t
META.yml Module meta-data (added by MakeMaker)
@@ -1,19 +1,22 @@
--- #YAML:1.0
name: Getopt-Euclid
-version: 0.2.4
+version: 0.2.7
abstract: Executable Uniform Command-Line Interface Descriptions
author:
- Damian Conway <DCONWAY@cpan.org>
-license: unknown
+license: perl
distribution_type: module
configure_requires:
ExtUtils::MakeMaker: 0
build_requires:
ExtUtils::MakeMaker: 0
requires:
+ File::Basename: 0
File::Spec::Functions: 0
List::Util: 0
+ Perl::Tidy: 0
Test::More: 0
+ Text::Balanced: 0
version: 0
no_index:
directory:
@@ -2,18 +2,24 @@ use strict;
use warnings;
use ExtUtils::MakeMaker;
+# If you updated this, don't forget to update the Build.PL file as well!
+
WriteMakefile(
NAME => 'Getopt::Euclid',
AUTHOR => 'Damian Conway <DCONWAY@cpan.org>',
+ LICENSE => 'perl',
VERSION_FROM => 'lib/Getopt/Euclid.pm',
ABSTRACT_FROM => 'lib/Getopt/Euclid.pm',
- PL_FILES => {},
PREREQ_PM => {
- 'Test::More' => 0,
- 'version' => 0,
+ 'Test::More' => 0,
+ 'version' => 0,
+ 'File::Basename' => 0,
'File::Spec::Functions' => 0,
- 'List::Util' => 0,
+ 'List::Util' => 0,
+ 'Text::Balanced' => 0,
+ 'Perl::Tidy' => 0,
},
+ PL_FILES => {},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'Getopt-Euclid-*' },
);
@@ -1,4 +1,4 @@
-Getopt::Euclid version 0.2.4
+Getopt::Euclid
Getopt::Euclid uses your program's own documentation to create a com-
mand-line argument parser. This ensures that your program's documented
@@ -43,8 +43,11 @@ Alternatively, to install with Module::Build, you can use the following commands
DEPENDENCIES
+File::Basename
File::Spec::Functions
List::Util
+Text::Balanced
+Perl::Tidy
COPYRIGHT AND LICENCE
@@ -1,55 +0,0 @@
-Getopt::Euclid version 0.2.4
-
- Getopt::Euclid uses your program's own documentation to create a com-
- mand-line argument parser. This ensures that your program's documented
- interface and its actual interface always agree.
-
- To use the module, you simply write:
-
- use Getopt::Euclid;
-
- at the top of your program.
-
- When the module is loaded within a regular Perl program, it will:
-
- 1. locate any POD in the same file,
- 2. extract information from that POD, most especially
- from the "=head1 REQUIRED ARGUMENTS" and "=head1
- OPTIONS" sections,
- 3. build a parser that parses the arguments and options the
- POD specifies,
- 4. parse the contents of @ARGV using that parser, and
- 5. put the results in the global %ARGV variable.
-
-
-INSTALLATION
-
-To install this module, run the following commands:
-
- perl Makefile.PL
- make
- make test
- make install
-
-
-Alternatively, to install with Module::Build, you can use the following commands:
-
- perl Build.PL
- ./Build
- ./Build test
- ./Build install
-
-
-
-DEPENDENCIES
-
-File::Spec::Functions
-List::Util
-
-
-COPYRIGHT AND LICENCE
-
-Copyright (C) 2005, Damian Conway
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
@@ -3,25 +3,3 @@ package Getopt::Euclid::HierDemo;
use Getopt::Euclid;
1;
-
-=head1 REQUIRED ARGUMENTS
-
-=over
-
-=item -i[nfile] [=]<file>
-
-Specify input file
-
-=for Euclid:
- file.type: readable
- file.default: '-'
-
-=item -o[ut][file]= <file>
-
-Specify output file
-
-=for Euclid:
- file.type: writable
- file.default: '-'
-
-=back
@@ -0,0 +1,21 @@
+=head1 REQUIRED ARGUMENTS
+
+=over
+
+=item -i[nfile] [=]<file>
+
+Specify input file
+
+=for Euclid:
+ file.type: readable
+ file.default: '-'
+
+=item -o[ut][file]= <file>
+
+Specify output file
+
+=for Euclid:
+ file.type: writable
+ file.default: '-'
+
+=back
@@ -0,0 +1,100 @@
+package Getopt::Euclid::PodExtract;
+
+
+=head1 NAME
+
+Getopt::Euclid::PodExtract - Perl::Tidy formatter to extract POD from source code
+
+=head1 SYNOPSIS
+
+ use Perl::Tidy;
+ my $source = 'somefile.pl';
+ my $pod = '';
+ Perl::Tidy::perltidy(
+ argv => [],
+ source => $source,
+ formatter => Getopt::Euclid::PodExtract->new(\$pod),
+ );
+ print $pod;
+
+=head1 DESCRIPTION
+
+This is a formatter to plug into Perl::Tidy. This formatter simply takes source
+code and deletes everything except for POD, which it returns in its raw form in
+the specified variable. Do not use the destination option of perltidy as it is
+ignored when using a formatter.
+
+Perl::Tidy seems to have a more robust POD parsing mechanisms than Pod::Parser
+or Pod::Simple, which makes it useful to correctly parse POD code, even when
+rogue POD hides inside Perl variables, as in this example:
+
+ use strict;
+ use warnings;
+
+ =head1 NAME
+
+ Tricky
+
+ =cut
+
+ print "Starting...\n--------\n";
+ my $var =<<EOS;
+
+ =head1 FAKE_POD_ENTRY_HERE
+
+ This should not be extracted as POD since it is the content of a variable
+
+ =cut
+
+ EOS
+
+ print $var;
+ print "--------\nDone!\n";
+ exit;
+
+ __END__
+
+ =head1 SYNOPSIS
+
+ Tricky file to test proper POD parsing
+
+=head1 AUTHOR
+
+Florent Angly C<< <florent.angly@gmail.com> >>
+
+=head1 LICENCE AND COPYRIGHT
+
+Copyright (c) 2011, Florent Angly C<< <florent.angly@gmail.com> >>
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
+
+
+
+sub new {
+ # Initialize formatter
+ my ($class, $strref) = @_;
+ my $self = {};
+ bless $self, ref($class) || $class;
+ die "Error: Need to initialize the Getopt::Euclid::PodExtract formatter ".
+ "with a string reference to store the results but none was given\n" if not
+ defined $strref;
+ die "Error: Need to initialize the Getopt::Euclid::PodExtract formatter ".
+ "with a string reference to store the results but a ".ref($strref).
+ " reference was given\n" if (not ref $strref eq 'SCALAR');
+ $self->{_strref} = $strref;
+ return $self;
+}
+
+
+sub write_line {
+ my ($self, $tokens) = @_;
+ # This is called by perltidy, for each source code line
+ # Print POD_START, POD and POD_END tokens only
+ ${$self->{_strref}} .= $tokens->{_line_text} if $tokens->{_line_type} =~ m/^POD/;
+}
+
+
+1;
@@ -1,16 +1,20 @@
package Getopt::Euclid;
-use version; $VERSION = qv('0.2.4');
+use version; $VERSION = qv('0.2.7');
use warnings;
use strict;
use Carp;
-use File::Spec::Functions qw(splitpath catpath);
+use File::Basename;
+use File::Spec::Functions qw(splitpath catpath catfile);
use List::Util qw( first );
-use Text::Balanced qw(extract_bracketed extract_multiple);
+use Text::Balanced qw(extract_bracketed extract_variable extract_multiple);
+use Getopt::Euclid::PodExtract;
+use Perl::Tidy;
# Set some module variables
-my $has_run;
+my $has_run = 0;
+my $constraints_processed = 0;
my @pm_pods;
my $minimal_keys;
my $vars_prefix;
@@ -105,7 +109,6 @@ sub import {
# Parse and export arguments
Getopt::Euclid->process_args( \@ARGV ) unless $defer;
-
}
@@ -138,6 +141,8 @@ sub process_args {
# arguments, and populate %ARGV (or export specific variable names)
my ($self, $args) = @_;
+ _process_constraints() unless $constraints_processed;
+
%ARGV = ();
# Handle standard args...
@@ -159,7 +164,8 @@ sub process_args {
exit;
}
- # Report problems in parsing...
+ # Subroutine to report problems during parsing...
+
*_bad_arglist = sub {
my (@msg) = @_;
my $msg = join q{}, @msg;
@@ -170,6 +176,7 @@ sub process_args {
};
# Run matcher...
+
my $all_args_ref = { %options_hash, %requireds_hash };
my $argv =
join( q{ }, map { my $arg = $_; $arg =~ tr/ \t/\0\1/; $arg } @$args );
@@ -178,6 +185,7 @@ sub process_args {
}
# Check all requireds have been found...
+
my @missing;
for my $req ( keys %requireds_hash ) {
push @missing, "\t$req\n" if !exists $ARGV{$req};
@@ -196,8 +204,8 @@ sub process_args {
_verify_args($all_args_ref);
- # Clean up @$args ... everything must have been parsed, so nothing left
-
+ # Clean up @$args since everything must have been parsed
+
@$args = ();
# Clean up %ARGV
@@ -269,7 +277,7 @@ sub process_args {
}
-# ###### Utility subs #############
+# # # # # # # # Utility subs # # # # # # # #
# Recursively remove decorations on %ARGV keys
@@ -307,11 +315,6 @@ sub _process_pod {
sub _process_prog_pod {
- # Acquire POD source...
- open my $fh, '<', $0
- or croak "Getopt::Euclid was unable to access POD\n($!)\nProblem was";
- my $source = do { local $/; <$fh> };
-
# Set up parsing rules...
my $HWS = qr{ [^\S\n]* }xms;
my $EOHEAD = qr{ (?= ^=head1 | \z) }xms;
@@ -338,33 +341,16 @@ sub _process_prog_pod {
)
}xms;
- my @pod_array = ();
- for my $pod ( $source, reverse @pm_pods ) {
-
- # Clean up line delimeters
- $pod =~ s{ [\n\r] }{\n}gx;
-
- # Clean up significant entities...
- $pod =~ s{ E<lt> }{<}gxms;
- $pod =~ s{ E<gt> }{>}gxms;
-
- # Sanitize PODs by removing rogue strings that contain POD text
- $pod =~ s{ <<(\S+).*? $POD_CMD .*? $POD_CMD .*? ^\1 }{<<$1;\n$1}gxms; # heredocs
- $pod =~ s{ (['"`]) $POD_CMD .*? $POD_CMD .*? \1 }{$1$1}gxms; # quoted
- $pod =~ s{ \( $POD_CMD .*? $POD_CMD .*? \) }{()}gxms; # bracketed
- $pod =~ s{ \{ $POD_CMD .*? $POD_CMD .*? \} }{{}}gxms;
- $pod =~ s{ \[ $POD_CMD .*? $POD_CMD .*? \] }{[]}gxms;
- $pod =~ s{ < $POD_CMD .*? $POD_CMD .*? > }{<>}gxms;
-
- # Extract POD alone...
- $pod = join "\n\n", $pod =~ m{ $POD_CMD .*? (?: $POD_CUT | \z ) }gxms;
-
- # Append to man
- push @pod_array, $pod if not $pod eq '';
+ # Acquire POD source...
+ my $source = $0;
+ $man = _get_pod( $source, reverse @pm_pods );
- }
+ # Clean up line delimeters
+ $man =~ s{ [\n\r] }{\n}gx;
- $man = join("\n=cut\n\n", @pod_array);
+ # Clean up significant entities...
+ $man =~ s{ E<lt> }{<}gxms;
+ $man =~ s{ E<gt> }{>}gxms;
# Put program name in man
($SCRIPT_NAME) = ( splitpath($0) )[-1];
@@ -561,10 +547,19 @@ sub _process_euclid_specs {
$arg->{var}{$var}{type_error} = $val;
}
elsif ( $field eq 'type' ) {
+
+ # Restore fully-qualified name to variables:
+ # $x becomes $main::x
+ # $::x becomes $main::x
+ # $Package::x stays as $Package::x
+ $val =~ s/([\$\@\%])(::[a-z0-9]+)/$1main$2/gi;
+ if ($val !~ m/::/) {
+ $val =~ s/([\$\@\%])/$1main::/gi;
+ }
+
my ( $matchtype, $comma, $constraint ) =
$val =~ m{(/(?:\.|.)+/ | [^,\s]+)\s*(?:(,))?\s*(.*)}xms;
$arg->{var}{$var}{type} = $matchtype;
-
if ( $comma && length $constraint ) {
( $arg->{var}{$var}{constraint_desc} = $constraint ) =~
s/\s*\b\Q$var\E\b\s*//g;
@@ -586,6 +581,7 @@ sub _process_euclid_specs {
: $STD_CONSTRAINT_FOR{$matchtype}
or _fail("Unknown .type constraint: $spec");
}
+
}
elsif ( $field eq 'default' ) {
eval "\$val = $val; 1"
@@ -637,6 +633,23 @@ sub _process_euclid_specs {
}
+sub _process_constraints {
+ # In constraints that use a variable, replace the variable name by its value
+ for my $hash (\%requireds_hash, \%options_hash) {
+ while ( my ($entry, $props) = each %$hash ) {
+ while ( my ($var_name, $var_props) = each %{$props->{'var'}} ) {
+ my $constraint = $var_props->{'constraint_desc'};
+ next if not defined $constraint;
+ for my $var_name (extract_multiple($constraint,[sub{extract_variable($_[0],'')}],undef,1)) {
+ my $var_val = eval $var_name;
+ $var_name = quotemeta($var_name);
+ $var_props->{'constraint_desc'} =~ s/$var_name/$var_val/;
+ }
+ }
+ }
+ }
+ $constraints_processed = 1;
+}
sub _minimize_name {
my ($name) = @_;
@@ -768,7 +781,6 @@ sub _verify_args {
}
undef %seen_vars;
-
# Enforce constraints and fill in defaults...
ARG:
for my $arg_name ( keys %{$arg_specs_ref} ) {
@@ -779,8 +791,7 @@ sub _verify_args {
&& !$arg_specs_ref->{$arg_name}{has_defaults};
# Ensure all vars exist within arg...
- my @vars = @{ $arg_specs_ref->{$arg_name}{placeholders} || [] };
-
+ my @vars = keys %{$arg_specs_ref->{$arg_name}{placeholders}};
for my $index ( 0 .. $#{ $ARGV{$arg_name} } ) {
my $entry = $ARGV{$arg_name}[$index];
@{$entry}{@vars} = @{$entry}{@vars};
@@ -855,6 +866,7 @@ sub _verify_args {
}
}
}
+
}
@@ -907,7 +919,7 @@ sub _convert_to_regex {
{ my ($var_name, $var_rep) = ($1, $2);
$var_name =~ s/(\s+)\[\\s\\0\\1]\*/$1/gxms;
my $type = $arg->{var}{$var_name}{type} || q{};
- push @{$arg->{placeholders}}, $var_name;
+ $arg->{placeholders}->{$var_name} = undef;
my $matcher = $type =~ m{\A\s*/.*/\s*\z}xms
? eval "qr$type"
: $STD_MATCHER_FOR{ $type }
@@ -1060,10 +1072,7 @@ sub _fail {
sub _process_pm_pod {
my @caller = caller(2); # at import()'s level
- # Save module's POD...
- open my $fh, '<', $caller[1]
- or croak "Getopt::Euclid was unable to access POD\n($!)\nProblem was";
- push @pm_pods, do { local $/; <$fh> };
+ push @pm_pods, $caller[1];
# Install this import() sub as module's import sub...
no strict 'refs';
@@ -1078,6 +1087,36 @@ sub _process_pm_pod {
}
+sub _get_pod {
+ # Extract source from a Perl script (.pl) or module (.pm), including content
+ # from corresponding .pod files if needed
+ my (@perl_files) = @_; # e.g. .pl, .pm or .t files
+
+ my $pod_string = '';
+ my $pod_extracter = Getopt::Euclid::PodExtract->new(\$pod_string);
+ for my $perl_file (@perl_files) {
+
+ # Get corresponding .pod file
+ my ($name, $path, $suffix) = fileparse($perl_file, qr/\.[^.]*/);
+ my $pod_file = catfile( $path, $name.'.pod' );
+ my @in_files = ($perl_file);
+ push @in_files, $pod_file if ( -e $pod_file );
+
+ # Extract POD...
+ for my $in_file (@in_files) {
+ Perl::Tidy::perltidy(
+ argv => [], # explicitly use no args to prevent use of @ARGV
+ source => $in_file,
+ formatter => $pod_extracter,
+ );
+ $pod_string .= "\n" if $pod_string;
+ }
+ }
+
+ return $pod_string;
+}
+
+
sub _insert_default_values {
my ($pod_items, $args, $order) = @_;
my $pod_string = '';
@@ -1119,7 +1158,7 @@ Getopt::Euclid - Executable Uniform Command-Line Interface Descriptions
=head1 VERSION
-This document describes Getopt::Euclid version 0.2.3
+This document describes Getopt::Euclid version 0.2.7
=head1 SYNOPSIS
@@ -1218,8 +1257,8 @@ This document describes Getopt::Euclid version 0.2.3
This module is free software. It may be used, redistributed
and/or modified under the terms of the Perl Artistic License
(see http://www.perl.com/perl/misc/Artistic.html)
-
-
+
+
=head1 DESCRIPTION
Getopt::Euclid uses your program's own documentation to create a command-line
@@ -1327,7 +1366,54 @@ C<process_args()> subroutine.
=head2 POD Interface
-This is where all the action is.
+This is where all the action is. POD markup can be placed in a .pod file that
+has the same prefix as the corresponding Perl file. Alternatively, POD can be
+inserted anywhere in the Perl code, but is typically added either after an
+__END__ statement (like in the L<SYNOPSIS>), or interspersed in the code:
+
+ use Getopt::Euclid;
+
+ =head1 NAME
+
+ yourprog - Your program here
+
+ =head1 REQUIRED ARGUMENTS
+
+ =over
+
+ =item -s[ize]=<h>x<w>
+
+ Specify size of simulation
+
+ =for Euclid:
+ h.type: int > 0
+ h.default: 24
+ w.type: int >= 10
+ w.default: 80
+
+ =back
+
+ =head1 OPTIONS
+
+ =over
+
+ =item -i
+
+ Specify interactive simulation
+
+ =back
+
+ =cut
+
+ if ($ARGV{-i}) {
+ print "Interactive mode...\n";
+ }
+
+ for my $x (0..$ARGV{-size}{h}-1) {
+ for my $y (0..$ARGV{-size}{w}-1) {
+ do_something_with($x, $y);
+ }
+ }
When Getopt::Euclid is loaded in a non-C<.pm> file, it searches that file for
the following POD documentation:
@@ -1360,7 +1446,7 @@ allowing for multi-level and "alpha" version numbers such as:
=head1 VERSION
This is version 1.2.3
-
+
or:
=head1 VERSION
@@ -1476,7 +1562,7 @@ Any of the above variations would cause all three of:
$ARGV{'-i'}
$ARGV{'-in'}
$ARGV{'--from'}
-
+
to be set to the string C<'data.txt'>.
You could allow the optional C<=> to also be an optional colon by specifying:
@@ -1722,6 +1808,27 @@ so it's important to qualify any subroutines that are not in that namespace.
Furthermore, any subroutines used must be defined (or loaded from a module)
I<before> the C<use Getopt::Euclid> statement.
+You can also use constraints that involve variables. You must use the :defer
+mode and the variables must be globally accessible:
+
+ use Getopt::Euclid qw(:defer);
+ our $MIN_VAL = 100;
+ Getopt::Euclid->process_args(\@ARGV);
+
+ __END__
+
+ =head1 OPTIONS
+
+ =over
+
+ =item --magnitude <magnitude>
+
+ =for Euclid
+ magnitude.type: number, magnitude > $MIN_VAL
+
+ =back
+
+
=head2 Standard placeholder types
Getopt::Euclid recognizes the following standard placeholder types:
@@ -1909,7 +2016,7 @@ as a cuddled version of:
By default, the module only stores arguments into the global %ARGV hash.
You can request that options are exported as variables into the calling package
-the special C<':vars'> specifier:
+using the special C<':vars'> specifier:
use Getopt::Euclid qw( :vars );
@@ -2041,9 +2148,11 @@ you may need to examine C<@ARGV> before it is processed (and emptied) by
Getopt::Euclid. Or you may intend to pass your own arguments manually only
using C<process_args()>.
-To allow to defer the parsing of arguments, use the specifier C<':defer'>:
+To defer the parsing of arguments, use the specifier C<':defer'>:
use Getopt::Euclid qw( :defer );
+ # Do something...
+ Getopt::Euclid->process_args(\@ARGV);
=head1 DIAGNOSTICS
@@ -2202,17 +2311,31 @@ Getopt::Euclid requires no configuration files or environment variables.
=item *
+File::Basename
+
+=item *
+
File::Spec::Functions
=item *
List::Util
+=item *
+
+Text::Balanced
+
+=item *
+
+Perl::Tidy
+
=back
=head1 INCOMPATIBILITIES
-None reported.
+Getopt::Euclid may not work properly with POD in Perl files that have been
+converted into an executable with PerlApp or similar software. A possible
+workaround may be to move the POD to a __DATA__ section or a separate .pod file.
=head1 BUGS AND LIMITATIONS
@@ -2220,6 +2343,13 @@ Please report any bugs or feature requests to
C<bug-getopt-euclid@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org>.
+Getopt::Euclid has a development repository on Sourceforge.net at
+L<http://sourceforge.net/scm/?type=git&group_id=259291> in which the code is
+managed by Git. Feel free to clone this repository and push patches! To get started:
+ git clone L<git://getopt-euclid.git.sourceforge.net/gitroot/getopt-euclid/getopt-euclid>)
+ git branch 0.2.x origin/0.2.x
+ git checkout 0.2.x
+
=head1 AUTHOR
Damian Conway C<< <DCONWAY@cpan.org> >>
@@ -116,7 +116,6 @@ This module is free software. It may be used, redistributed
and/or modified under the terms of the Perl Artistic License
(see http://www.perl.com/perl/misc/Artistic.html)
-=cut
=head1 REQUIRED ARGUMENTS
@@ -133,6 +132,7 @@ Specify output file
=back
+
';
my $man_test = Getopt::Euclid->man();
@@ -31,6 +31,7 @@ Specify output file
=back
+
';
my $man_test = Getopt::Euclid->man();
@@ -185,6 +185,7 @@ Copyright (c) 2002, Damian Conway. All Rights Reserved.
This module is free software. It may be used, redistributed
and/or modified under the terms of the Perl Artistic License
(see http://www.perl.com/perl/misc/Artistic.html)
+
};
@@ -110,6 +110,7 @@ Copyright (c) 2002, Damian Conway. All Rights Reserved.
This module is free software. It may be used, redistributed
and/or modified under the terms of the Perl Artistic License
(see http://www.perl.com/perl/misc/Artistic.html)
+
};
@@ -0,0 +1,110 @@
+=head1 NAME
+
+orchestrate - Convert a file to Melkor's .orc format
+
+=head1 VERSION
+
+This documentation refers to orchestrate version 1.9.4
+
+=head1 USAGE
+
+ orchestrate -in source.txt --out dest.orc -verbose -len=24
+
+=head1 REQUIRED ARGUMENTS
+
+=over
+
+=item -i[nfile] [=]<file>
+
+Specify input file
+
+=for Euclid:
+ file.type: readable
+ file.default: '-'
+
+=item -o[ut][file]= <out_file>
+
+Specify output file
+
+=for Euclid:
+ out_file.type: writable
+ out_file.default: '-'
+
+=back
+
+=head1 OPTIONS
+
+=over
+
+=item size <h>x<w>
+
+Specify height and width
+
+=item -l[[en][gth]] <l>
+
+Display length [default: 24 ]
+
+=for Euclid:
+ l.type: int > 0
+ l.default: 24
+
+=item -girth <g>
+
+Display girth [default: 42 ]
+
+=for Euclid:
+ g.default: 42
+
+=item -v[erbose]
+
+Print all warnings
+
+=item --timeout [<min>] [<max>]
+
+=for Euclid:
+ min.type: int
+ max.type: int
+ max.default: -1
+
+=item -w <space> | --with <space>
+
+Test something spaced
+
+=item <step>
+
+Step size
+
+=for Euclid:
+ step.type: int, lucky(step)
+
+=item --version
+
+=item --usage
+
+=item --help
+
+=item --man
+
+Print the usual program information
+
+=back
+
+=begin remainder of documentation here...
+
+=end
+
+=head1 AUTHOR
+
+Damian Conway (damian@conway.org)
+
+=head1 BUGS
+
+There are undoubtedly serious bugs lurking somewhere in this code.
+Bug reports and other feedback are most welcome.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2002, Damian Conway. All Rights Reserved.
+This module is free software. It may be used, redistributed
+and/or modified under the terms of the Perl Artistic License
+ (see http://www.perl.com/perl/misc/Artistic.html)
@@ -0,0 +1,70 @@
+BEGIN {
+ $INFILE = $0;
+ $OUTFILE = $0;
+ $LEN = 42;
+ $H = 2;
+ $W = -10;
+ $TIMEOUT = 7;
+
+ @ARGV = (
+ "-i $INFILE",
+ "-out=", $OUTFILE,
+ "-lgth $LEN",
+ "size ${H}x${W}",
+ '-v',
+ "--timeout $TIMEOUT",
+ '--with', 's p a c e s',
+ 7,
+ );
+
+ chmod 0644, $0;
+}
+
+sub lucky {
+ my ($num) = @_;
+ return $num == 7;
+}
+
+# Read POD from .pod file
+
+use Getopt::Euclid;
+
+use Test::More 'no_plan';
+
+sub got_arg {
+ my ($key, $val) = @_;
+ is $ARGV{$key}, $val, "Got expected value for $key";
+}
+
+is keys %ARGV, 18 => 'Right number of args returned';
+
+got_arg -i => $INFILE;
+got_arg -infile => $INFILE;
+
+got_arg -l => $LEN;
+got_arg -len => $LEN;
+got_arg -length => $LEN;
+got_arg -lgth => $LEN;
+
+got_arg -girth => 42;
+
+got_arg -o => $OUTFILE;
+got_arg -ofile => $OUTFILE;
+got_arg -out => $OUTFILE;
+got_arg -outfile => $OUTFILE;
+
+got_arg -v => 1,
+got_arg -verbose => 1,
+
+is ref $ARGV{'--timeout'}, 'HASH' => 'Hash reference returned for timeout';
+is $ARGV{'--timeout'}{min}, $TIMEOUT => 'Got expected value for timeout <min>';
+is $ARGV{'--timeout'}{max}, -1 => 'Got default value for timeout <max>';
+
+is ref $ARGV{size}, 'HASH' => 'Hash reference returned for size';
+is $ARGV{size}{h}, $H => 'Got expected value for size <h>';
+is $ARGV{size}{w}, $W => 'Got expected value for size <w>';
+
+is $ARGV{'--with'}, 's p a c e s' => 'Handled spaces correctly';
+is $ARGV{-w}, 's p a c e s' => 'Handled alternation correctly';
+
+is $ARGV{'<step>'}, 7 => 'Handled step size correctly';
@@ -1,69 +0,0 @@
-BEGIN {
- @ARGV = (
- "-h=hostname1234",
- "-dim=3,4",
- );
-}
-
-use Getopt::Euclid;
-
-use Test::More 'no_plan';
-
-sub got_arg {
- my ($key, $val) = @_;
- is $ARGV{$key}, $val, "Got expected value for $key";
-}
-
-is $ARGV{'-h'}{dev}, 'hostname' => 'Got expected value for -h <dev>';
-is $ARGV{'-h'}{port}, 1234 => 'Got expected value for -h <port>';
-is $ARGV{'-dim'}, '3,4' => 'Got expected value for -dim';
-
-__END__
-
-=head1 NAME
-
-orchestrate - Convert a file to Melkor's .orc format
-
-=head1 VERSION
-
-This documentation refers to orchestrate version 1.9.4
-
-=head1 USAGE
-
- orchestrate -in source.txt --out dest.orc -verbose -len=24
-
-=head1 REQUIRED ARGUMENTS
-
-=over
-
-=item -h = <dev>[<port>]
-
-Specify device/port
-
-=for Euclid:
- dev.type: /[^:\s\d]+\D/
- port.type: /\d+/
-
-=item -dim=<dim>
-
-=for Euclid:
- dim.type: /\d+,\d+/
-
-=back
-
-=head1 AUTHOR
-
-Damian Conway (damian@conway.org)
-
-=head1 BUGS
-
-There are undoubtedly serious bugs lurking somewhere in this code.
-Bug reports and other feedback are most welcome.
-
-=head1 COPYRIGHT
-
-Copyright (c) 2002, Damian Conway. All Rights Reserved.
-This module is free software. It may be used, redistributed
-and/or modified under the terms of the Perl Artistic License
- (see http://www.perl.com/perl/misc/Artistic.html)
-
@@ -110,8 +110,8 @@ got_args $ARGV{'-writeable'}, [$OUT1, $OUT2];
got_args $ARGV{'-output'}, [$OUT1, $OUT2];
got_args $ARGV{'-out'}, [$OUT1, $OUT2];
-# type 'regex' tested in file ./t/regex_types.t
-
+# type 'regex' tested in file ./t/types_regex.t
+# comparison to $variables are tested in file ./t/types_vars.t
__END__
@@ -0,0 +1,69 @@
+BEGIN {
+ @ARGV = (
+ "-h=hostname1234",
+ "-dim=3,4",
+ );
+}
+
+use Getopt::Euclid;
+
+use Test::More 'no_plan';
+
+sub got_arg {
+ my ($key, $val) = @_;
+ is $ARGV{$key}, $val, "Got expected value for $key";
+}
+
+is $ARGV{'-h'}{dev}, 'hostname' => 'Got expected value for -h <dev>';
+is $ARGV{'-h'}{port}, 1234 => 'Got expected value for -h <port>';
+is $ARGV{'-dim'}, '3,4' => 'Got expected value for -dim';
+
+__END__
+
+=head1 NAME
+
+orchestrate - Convert a file to Melkor's .orc format
+
+=head1 VERSION
+
+This documentation refers to orchestrate version 1.9.4
+
+=head1 USAGE
+
+ orchestrate -in source.txt --out dest.orc -verbose -len=24
+
+=head1 REQUIRED ARGUMENTS
+
+=over
+
+=item -h = <dev>[<port>]
+
+Specify device/port
+
+=for Euclid:
+ dev.type: /[^:\s\d]+\D/
+ port.type: /\d+/
+
+=item -dim=<dim>
+
+=for Euclid:
+ dim.type: /\d+,\d+/
+
+=back
+
+=head1 AUTHOR
+
+Damian Conway (damian@conway.org)
+
+=head1 BUGS
+
+There are undoubtedly serious bugs lurking somewhere in this code.
+Bug reports and other feedback are most welcome.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2002, Damian Conway. All Rights Reserved.
+This module is free software. It may be used, redistributed
+and/or modified under the terms of the Perl Artistic License
+ (see http://www.perl.com/perl/misc/Artistic.html)
+
@@ -0,0 +1,84 @@
+BEGIN {
+ @ARGV = (
+ "--alpha aaa",
+ "--beta 0.8",
+ "--gamma 123",
+ "--delta asdf",
+ "--epsilon abcdef",
+ "--mu 256"
+ );
+}
+
+use Getopt::Euclid qw(:defer);
+
+use Test::More 'no_plan';
+
+
+our $TEST = 'aaa';
+
+our @THRESH;
+$THRESH[0] = 0;
+$THRESH[1] = 1;
+
+our $VAL = 123;
+
+our %RE;
+$RE{letters} = '[a-z]+';
+
+$::STRING = 'abcdefghij';
+
+$Package::EXIT_STATUS = 0;
+
+Getopt::Euclid->process_args(\@ARGV);
+
+
+is $ARGV{'--alpha'}, 'aaa' ;
+is $ARGV{'--beta'} , 0.8 ;
+is $ARGV{'--gamma'}, 123 ;
+is $ARGV{'--delta'}, 'asdf' ;
+is $ARGV{'--epsilon'}, 'abcdef';
+is $ARGV{'--mu'}, 256 ;
+
+__END__
+
+=head1 OPTIONS
+
+=over
+
+=item --alpha <alpha>
+
+=for Euclid
+ alpha.type: string, alpha eq $TEST
+
+
+=item --beta <beta>
+
+=for Euclid
+ beta.type: number, beta > $THRESH[0] && beta < $THRESH[1]
+
+
+=item --gamma <gamma>
+
+=for Euclid
+ gamma.type: number, gamma == $VAL
+
+
+=item --delta <delta>
+
+=for Euclid
+ delta.type: string, delta =~ /$RE{letters}/
+
+
+=item --epsilon <epsilon>
+
+=for Euclid
+ epsilon.type: string, length(epsilon) < length($::STRING)
+
+
+=item --mu <mu>
+
+=for Euclid
+ mu.type: number, mu != $Package::EXIT_STATUS
+
+
+=back